home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Nordlicht Spiele / Nordlicht Spiele 05-04 (19xx)(Nordlicht)(DE)(PD).zip / Nordlicht Spiele 05-04 (19xx)(Nordlicht)(DE)(PD).adf / Genius.mod < prev    next >
Text File  |  1996-12-24  |  8KB  |  359 lines
  1. MODULE Genius; (* HAK/26aug88 *)
  2.  
  3. FROM Dos       IMPORT Close,Delay,FileHandlePtr,Open,Read;
  4. FROM Exec      IMPORT AllocMem,CopyMem,FreeMem,MemReqs,MemReqSet;
  5. FROM Graphics  IMPORT BitMapPtr,LoadRGB4,RastPortPtr,SetRGB4,ViewModeSet,
  6.                       ViewPortPtr;
  7. FROM Intuition IMPORT ClearPointer,CloseScreen,CloseWindow,customScreen,
  8.                       DrawImage,IDCMPFlagSet,Image,NewScreen,NewWindow,
  9.                       ScreenPtr,SetPointer,OpenScreen,OpenWindow,WindowFlags,
  10.                       WindowFlagSet,WindowPtr;
  11. FROM SYSTEM    IMPORT ADR,ADDRESS,INLINE;
  12.  
  13. VAR
  14.   chxp           : CARDINAL;
  15.   chyp           : CARDINAL;
  16.   comc           : ARRAY [0..4] OF CARDINAL;
  17.   comp           : ARRAY [0..4] OF CARDINAL;
  18.   du10           : LONGINT;
  19.   du20           : CARDINAL;
  20.   du21           : CARDINAL;
  21.   imag           : Image;
  22.   kor0           : CARDINAL;
  23.   kor1           : CARDINAL;
  24.   lop0           : BOOLEAN;
  25.   lop1           : BOOLEAN;
  26.   moux           : INTEGER;
  27.   mouy           : INTEGER;
  28.   ciaa[0BFE001H] : SET OF [0..7];
  29.   pics           : ADDRESS;
  30.   potr           : ADDRESS;
  31.   rapp           : RastPortPtr;
  32.   rand[0DFF006H] : CARDINAL;
  33.   scrn           : ScreenPtr;
  34.   succ           : BOOLEAN;
  35.   vipp           : ViewPortPtr;
  36.   wind           : WindowPtr;
  37.  
  38. PROCEDURE OpenScr():ScreenPtr;
  39. VAR
  40.   nscr : NewScreen;
  41.   scpt : ScreenPtr;
  42.  
  43. BEGIN
  44.   WITH nscr DO
  45.     leftEdge:=0;
  46.     topEdge:=0;
  47.     width:=320;
  48.     height:=256;
  49.     depth:=5;
  50.     detailPen:=0;
  51.     blockPen:=0;
  52.     viewModes:=ViewModeSet{};
  53.     type:=customScreen;
  54.     font:=NIL;
  55.     defaultTitle:=NIL;
  56.     gadgets:=NIL;
  57.     customBitMap:=NIL;
  58.   END;
  59.   scpt:=OpenScreen(nscr);
  60.   RETURN(scpt);
  61. END OpenScr;
  62.  
  63. PROCEDURE OpenWin(scpt:ScreenPtr):WindowPtr;
  64. VAR
  65.   nwin : NewWindow;
  66.   wipt : WindowPtr;
  67.  
  68. BEGIN
  69.   WITH nwin DO
  70.     leftEdge:=0;
  71.     topEdge:=0;
  72.     width:=320;
  73.     height:=256;
  74.     detailPen:=0;
  75.     blockPen:=0;
  76.     idcmpFlags:=IDCMPFlagSet{};
  77.     flags:=WindowFlagSet{activate,rmbTrap};
  78.     firstGadget:=NIL;
  79.     checkMark:=NIL;
  80.     title:=NIL;
  81.     screen:=scpt;
  82.     bitMap:=NIL;
  83.     minWidth:=320;
  84.     minHeight:=256;
  85.     maxWidth:=320;
  86.     maxHeight:=256;
  87.     type:=customScreen;
  88.   END;
  89.   wipt:=OpenWindow(nwin);
  90.   RETURN(wipt);
  91. END OpenWin;
  92.  
  93. PROCEDURE SetColors1;
  94. VAR
  95.   colr : CARDINAL;
  96.  
  97. BEGIN
  98.   FOR colr:=0 TO 31 DO
  99.     SetRGB4(vipp,colr,0,0,0);
  100.   END;
  101. END SetColors1;
  102.  
  103. PROCEDURE Colortable;
  104. BEGIN
  105.   INLINE(0000H,0BBBH,0D90H,0999H,0777H,0DDDH,0AAAH);
  106.   INLINE(0FB0H,0A60H,0666H,0555H,0CCCH,0F0FH,0720H);
  107.   INLINE(00C3H,000FH,0F00H,0F8BH,0000H,0FF0H,0FE0H,0FFFH);
  108. END Colortable;
  109.  
  110. PROCEDURE Loaddata;
  111. VAR
  112.   bimp : BitMapPtr;
  113.   bipp : ADDRESS;
  114.   fihp : FileHandlePtr;
  115.   plsc : INTEGER;
  116.  
  117. BEGIN
  118.   bimp:=rapp^.bitMap;
  119.   pics:=AllocMem(5930,MemReqSet{chip,memClear});
  120.   fihp:=Open(ADR("Genius-Data"),1005);
  121.   FOR plsc:=0 TO 4 DO
  122.     bipp:=bimp^.planes[plsc];
  123.     du10:=Read(fihp,bipp,10240);
  124.   END;
  125.   du10:=Read(fihp,pics,5930);
  126.   Close(fihp);
  127. END Loaddata;
  128.  
  129. PROCEDURE Pointerdata;
  130. BEGIN
  131.   INLINE(00000H,00000H);
  132.   INLINE(00000H,00800H,00800H,01400H,00800H,01400H,00800H,01400H);
  133.   INLINE(00800H,016A0H,00AA0H,05550H,04AA0H,0B550H,06AA0H,09550H);
  134.   INLINE(03FE0H,04010H,01FC0H,02020H,00FC0H,01020H,00F80H,01040H);
  135.   INLINE(00000H,03FE0H,01FC0H,03FE0H,017C0H,03FE0H,01FC0H,03FE0H);
  136.   INLINE(00000H,00000H);
  137. END Pointerdata;
  138.  
  139. PROCEDURE Pointer;
  140. BEGIN
  141.   potr:=AllocMem(72,MemReqSet{chip,memClear});
  142.   CopyMem(ADR(Pointerdata)+10,potr,72);
  143.   SetPointer(wind,potr,16,16,-5,-1);
  144. END Pointer;
  145.  
  146. PROCEDURE ChooseCombination;
  147. BEGIN
  148.   FOR du20:=0 TO 4 DO
  149.     succ:=FALSE;
  150.     WHILE succ=FALSE DO
  151.       succ:=TRUE;
  152.       comc[du20]:=rand MOD 7;
  153.       FOR du21:=0 TO du20 DO
  154.         IF (du20#du21) AND (comc[du20]=comc[du21]) THEN
  155.           succ:=FALSE;
  156.         END;
  157.       END;
  158.     END;
  159.   END;
  160.   chxp:=0;
  161.   chyp:=7;
  162. END ChooseCombination;
  163.  
  164. PROCEDURE CheckMouse;
  165. BEGIN
  166.   WHILE (6 IN ciaa) DO
  167.   END;
  168.   moux:=scrn^.mouseX;
  169.   mouy:=scrn^.mouseY;
  170.   Delay(5);
  171.   WHILE (6 IN ciaa)=FALSE DO
  172.   END;
  173.   succ:=TRUE;
  174.   IF (moux>226) AND (mouy<36) THEN
  175.     lop1:=FALSE;
  176.   ELSE
  177.     IF (moux<25) OR (moux>45) THEN
  178.       succ:=FALSE;
  179.     ELSIF (mouy>37) AND (mouy<57) THEN
  180.       comp[chxp]:=0;
  181.     ELSIF (mouy>69) AND (mouy<89) THEN
  182.       comp[chxp]:=1;
  183.     ELSIF (mouy>101) AND (mouy<121) THEN
  184.       comp[chxp]:=2;
  185.     ELSIF (mouy>133) AND (mouy<153) THEN
  186.       comp[chxp]:=3;
  187.     ELSIF (mouy>165) AND (mouy<185) THEN
  188.       comp[chxp]:=4;
  189.     ELSIF (mouy>197) AND (mouy<217) THEN
  190.       comp[chxp]:=5;
  191.     ELSIF (mouy>229) AND (mouy<249) THEN
  192.       comp[chxp]:=6;
  193.     ELSE
  194.       succ:=FALSE;
  195.     END;
  196.     FOR du20:=0 TO chxp DO
  197.       IF (comp[du20]=comp[chxp]) AND (du20#chxp) THEN
  198.         succ:=FALSE;
  199.       END;
  200.     END;
  201.   END;
  202. END CheckMouse;
  203.  
  204. PROCEDURE SetChip;
  205. BEGIN
  206.   imag.width:=15;
  207.   imag.height:=13;
  208.   imag.imageData:=pics+4690+LONGINT(130*comp[chxp]);
  209.   DrawImage(rapp,ADR(imag),91+25*INTEGER(chxp),57+24*INTEGER(chyp));
  210.   chxp:=chxp+1;
  211. END SetChip;
  212.  
  213. PROCEDURE CheckRow;
  214. BEGIN
  215.   kor0:=0;
  216.   kor1:=0;
  217.   FOR du20:=0 TO 4 DO
  218.     IF comp[du20]=comc[du20] THEN
  219.       kor0:=kor0+1;
  220.     END;
  221.   END;
  222.   IF kor0=5 THEN
  223.     lop1:=FALSE;
  224.   END;
  225.   FOR du20:=0 TO 4 DO
  226.     FOR du21:=0 TO 4 DO
  227.       IF (du20#du21) AND (comp[du20]=comc[du21]) THEN
  228.         kor1:=kor1+1;
  229.       END;
  230.     END;
  231.   END;
  232.   du20:=0;
  233.   du21:=kor0;
  234.   imag.width:=8;
  235.   imag.height:=11;
  236.   imag.imageData:=pics+5710;
  237.   WHILE du21>0 DO
  238.     DrawImage(rapp,ADR(imag),227+10*INTEGER(du20),58+24*INTEGER(chyp));
  239.     du21:=du21-1;
  240.     du20:=du20+1;
  241.   END;
  242.   imag.imageData:=pics+5820;
  243.   WHILE kor1>0 DO
  244.     DrawImage(rapp,ADR(imag),227+10*INTEGER(du20),58+24*INTEGER(chyp));
  245.     kor1:=kor1-1;
  246.     du20:=du20+1;
  247.   END;
  248. END CheckRow;
  249.  
  250. PROCEDURE ShowCombination;
  251. BEGIN
  252.   imag.width:=15;
  253.   imag.height:=13;
  254.   FOR du20:=0 TO 4 DO
  255.     imag.imageData:=pics+4690+LONGINT(comc[du20]*130);
  256.     DrawImage(rapp,ADR(imag),91+25*INTEGER(du20),17);
  257.   END;
  258.   imag.width:=95;
  259.   imag.height:=38;
  260.   imag.imageData:=pics+2280;
  261.   DrawImage(rapp,ADR(imag),225,0);
  262. END ShowCombination;
  263.  
  264. PROCEDURE ChipClear;
  265. BEGIN
  266.   imag.width:=15;
  267.   imag.height:=13;
  268.   imag.imageData:=pics+4560;
  269.   FOR du20:=0 TO 4 DO
  270.     DrawImage(rapp,ADR(imag),91+25*INTEGER(du20),17);
  271.   END;
  272.   FOR du20:=0 TO 7 DO
  273.     FOR du21:=0 TO 4 DO
  274.       DrawImage(rapp,ADR(imag),91+25*INTEGER(du21),57+24*INTEGER(du20));
  275.     END;
  276.   END;
  277.   imag.width:=8;
  278.   imag.height:=11;
  279.   imag.imageData:=pics+5600;
  280.   FOR du20:=0 TO 7 DO
  281.     FOR du21:=0 TO 4 DO
  282.       DrawImage(rapp,ADR(imag),227+10*INTEGER(du21),58+24*INTEGER(du20));
  283.     END;
  284.   END;
  285.   imag.width:=95;
  286.   imag.height:=38;
  287.   imag.imageData:=pics;
  288.   DrawImage(rapp,ADR(imag),225,0);
  289. END ChipClear;
  290.  
  291. PROCEDURE Continue;
  292. BEGIN
  293.   succ:=FALSE;
  294.   WHILE succ=FALSE DO
  295.     WHILE (6 IN ciaa) DO
  296.     END;
  297.     moux:=scrn^.mouseX;
  298.     mouy:=scrn^.mouseY;
  299.     WHILE (6 IN ciaa)=FALSE DO
  300.     END;
  301.     IF (moux>226) AND (moux<265) AND
  302.     (mouy>1) AND (mouy<36) THEN
  303.       lop0:=FALSE;
  304.       succ:=TRUE;
  305.     END;
  306.     IF (moux>264) AND (moux<318) AND
  307.     (mouy>1) AND (mouy<36) THEN
  308.       ChipClear;
  309.       succ:=TRUE;
  310.     END;
  311.   END;
  312. END Continue;
  313.  
  314. BEGIN
  315.   scrn:=OpenScr();
  316.   wind:=OpenWin(scrn);
  317.   vipp:=ADR(scrn^.viewPort);
  318.   rapp:=ADR(scrn^.rastPort);
  319.   SetColors1;
  320.   Pointer;
  321.   Loaddata;
  322.   WITH imag DO
  323.     leftEdge:=0;
  324.     topEdge:=0;
  325.     depth:=5;
  326.     planePick:=31;
  327.     planeOnOff:=0;
  328.     nextImage:=NIL;
  329.   END;
  330.   LoadRGB4(vipp,ADR(Colortable)+10,22);
  331.   lop0:=TRUE;
  332.   REPEAT
  333.     ChooseCombination;
  334.     lop1:=TRUE;
  335.     REPEAT
  336.       CheckMouse;
  337.         IF (lop1=TRUE) AND (succ=TRUE) THEN
  338.           SetChip;
  339.           IF chxp=5 THEN
  340.             CheckRow;
  341.             IF chyp=0 THEN
  342.               lop1:=FALSE;
  343.             ELSE
  344.               chxp:=0;
  345.               chyp:=chyp-1;
  346.             END;
  347.           END;
  348.         END;
  349.     UNTIL lop1=FALSE;
  350.     ShowCombination;
  351.     Continue;
  352.   UNTIL lop0=FALSE;
  353.   FreeMem(pics,5930);
  354.   ClearPointer(wind);
  355.   FreeMem(potr,72);
  356.   CloseWindow(wind);
  357.   CloseScreen(scrn);
  358. END Genius.
  359.